VERSION 5.00
Begin VB.Form frmColorSelector 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   3255
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3975
   FillColor       =   &H8000000F&
   Icon            =   "ColorSel.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3255
   ScaleWidth      =   3975
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.PictureBox P1 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   2235
      Left            =   0
      ScaleHeight     =   2235
      ScaleWidth      =   3705
      TabIndex        =   0
      Top             =   0
      Width           =   3705
      Begin VB.PictureBox Picture1 
         Appearance      =   0  'Flat
         BackColor       =   &H00C0C0C0&
         ForeColor       =   &H80000008&
         Height          =   240
         Left            =   3450
         ScaleHeight     =   210
         ScaleWidth      =   210
         TabIndex        =   1
         Top             =   240
         Width           =   240
      End
   End
Attribute VB_Name = "frmColorSelector"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Color As Long
Private Colors(1 To 48) As Long
Private Circ As Collection
Private WithEvents cmdOK As ComboPack.Button
Attribute cmdOK.VB_VarHelpID = -1
Private WithEvents cmdCancel As ComboPack.Button
Attribute cmdCancel.VB_VarHelpID = -1
Private Sub cmdCancel_Click()
End Sub
Private Sub cmdOK_Click()
Color = Picture1.BackColor
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdOK.MouseDown Button, X, Y
cmdCancel.MouseDown Button, X, Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdCancel.MouseMove Button, X, Y
cmdOK.MouseMove Button, X, Y
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdOK.MouseUp Button, X, Y
cmdCancel.MouseUp Button, X, Y
'\\//'
End Sub
Private Sub cmdOK_Press()
cmdOK.HasFocus = True
cmdCancel.HasFocus = False
End Sub
Private Sub cmdCancel_Press()
cmdCancel.HasFocus = True
cmdOK.HasFocus = False
End Sub
Private Sub Form_Load()
Dim L1 As Long, L2 As Long
SetColors
Set cmdOK = New ComboPack.Button
Set cmdOK.Parent = frmColorSelector
cmdOK.Left = Width / 2 - 562.5
cmdOK.Top = 2310
cmdOK.Height = 405
cmdOK.Width = 1125
cmdOK.ForeColor = 0
cmdOK.BackColor = -2147483633
cmdOK.Name = "cmdOK"
cmdOK.Caption = "OK"
cmdOK.Redraw
cmdOK.Enabled = True
cmdOK.HasFocus = True
Set cmdCancel = New ComboPack.Button
Set cmdCancel.Parent = frmColorSelector
cmdCancel.Left = Width / 2 - 562.5
cmdCancel.Top = 2730
cmdCancel.Height = 405
cmdCancel.Width = 1125
cmdCancel.ForeColor = 0
cmdCancel.BackColor = -2147483633
cmdCancel.Name = "cmdCancel"
cmdCancel.Caption = "Cancel"
cmdCancel.Redraw
cmdCancel.Enabled = True
Set Circ = New Collection
Dim cCirc As clsCircle
Dim Color As Byte
For L1 = 1 To 9
For L2 = 1 To 5
Set cCirc = New clsCircle
Draw3DCircle P1, 240 + (360 * L1) - 240, 240 + (360 * L2) - 240, 120, Colors(Color + 1), True, True
cCirc.Color = Colors(Color + 1)
cCirc.Left = 240 + (360 * L1) - 360
cCirc.Top = 240 + (360 * L2) - 360
cCirc.Size = 240
Circ.Add cCirc
Color = Color + 1
'Clipboard.Clear
'Clipboard.SetText BtnMngrToCode(CommandToCls(Me))
SetColor Picture1.BackColor
End Sub
Private Sub P1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim clsCircle As clsCircle
Dim Found As Boolean
For Each clsCircle In Circ
If X > clsCircle.Left And X < clsCircle.Left + clsCircle.Size And Y > clsCircle.Top And (Y < clsCircle.Top + clsCircle.Size) Then
Found = True
End If
If Not Found Then Exit Sub
P1.Cls
For Each clsCircle In Circ
Draw3DCircle P1, clsCircle.Left + 120, clsCircle.Top + 120, 120, clsCircle.Color, True, True
For Each clsCircle In Circ
If X > clsCircle.Left And X < clsCircle.Left + clsCircle.Size And Y > clsCircle.Top And (Y < clsCircle.Top + clsCircle.Size) Then
Picture1.BackColor = clsCircle.Color
DrawMode = 6
DrawCross P1, clsCircle.Left, clsCircle.Top, QBColor(15)
DrawMode = 13
End If
End Sub
Public Sub SetColor(Color As Long)
Dim clsCircle As clsCircle
P1.Cls
For Each clsCircle In Circ
Draw3DCircle P1, clsCircle.Left + 120, clsCircle.Top + 120, 120, clsCircle.Color, True, True
For Each clsCircle In Circ
If clsCircle.Color = Color Then
DrawCross P1, clsCircle.Left, clsCircle.Top, QBColor(15)
End If
End Sub
Private Sub SetColors()
Colors(1) = &HFFFFFF
Colors(2) = &HE0E0E0
Colors(3) = &HC0C0C0
Colors(4) = &H808080
Colors(5) = &H404040
Colors(6) = &HC0C0FF
Colors(7) = &H8080FF
Colors(8) = &HFF&
Colors(9) = &HC0&
Colors(10) = &H80&
Colors(11) = &H40&
Colors(12) = &HC0E0FF
Colors(13) = &H80C0FF
Colors(14) = &H80FF&
Colors(15) = &H40C0&
Colors(16) = &H80C0FF
Colors(17) = &H4080&
Colors(18) = &H404080
Colors(19) = &HC0FFFF
Colors(20) = &H80FFFF
Colors(21) = &HFFFF&
Colors(22) = &HC0C0&
Colors(23) = &H8080&
Colors(24) = &HC0FFC0
Colors(25) = &H80FF80
Colors(26) = &HFF00&
Colors(27) = &HC000&
Colors(28) = &H8000&
Colors(29) = &HFFFFC0
Colors(30) = &HFFFF80
Colors(31) = &HFFFF00
Colors(32) = &HC0C000
Colors(33) = &H808000
Colors(34) = &HFFC0C0
Colors(35) = &HFF8080
Colors(36) = &HFF0000
Colors(37) = &HC00000
Colors(38) = &H800000
Colors(39) = &HFFC0FF
Colors(40) = &HFF80FF
Colors(41) = &HFF00FF
Colors(42) = &HC000C0
Colors(43) = &H800080
Colors(44) = &HC0E0FF
Colors(45) = &H8000000D
Colors(46) = &H8000000E
Colors(47) = &H8000000F
Colors(48) = &H80000010
End Sub